home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
aijournl
/
1986_09
/
cli.sai
< prev
next >
Wrap
Text File
|
1986-06-07
|
2KB
|
71 lines
CLI LISP Drunken Sailor Problem
;
;; The Drunken Sailor Problem
;
(defun drunken ()
(lo-res)
(set-pallette 1)
(setf x 160
y 100
*step* 5
*-step* (- *step*)
side 70
xbot (- x side)
xtop (+ x side)
ybot (- y side)
ytop (+ y side))
; draw the starting location
(draw-box x y *step* *-step*)
; draw the finish line
(draw-box x y side (- side))
; set a large time slice because there will be alot of switching
(setf *time-slice* 300)
; initiate concurrent execution
(cobegin '(walk x y 1) '(walk x y 2) '(walk x y 3))
(alpha)
)
(defun draw-box (x y d+ d-)
(%draw-line (+ x d-) (+ y d-) (+ x d+) (+ y d-) 1 0)
(%draw-line (+ x d+) (+ y d-) (+ x d+) (+ y d+) 1 0)
(%draw-line (+ x d+) (+ y d+) (+ x d-) (+ y d+) 1 0)
(%draw-line (+ x d-) (+ y d+) (+ x d-) (+ y d-) 1 0)è)
(defun walk (x y color)
(let ((x-old x)
(y-old y))
(do ((x-new (step x-old)
(step x-old))
(y-new (step y-old)
(step y-old)))
((done-p x-old y-old))
; use the gclisp drawing primitive
(%draw-line x-old y-old x-new y-new color 0)
(setf x-old x-new)
(setf y-old y-new)))
)
(defun step (old)
; take random steps
(+ old (rand *-step* *step*))
)
(defun done-p (x y)
(or (< x xbot) (> x xtop)
(< y ybot) (> y ytop))
)
; taken from the gclisp examples
; load the line drawing primitive
(UNLESS (FBOUNDP '%DRAW-LINE)
(WITH-DISKETTE *EXAMPLE-DISKETTE* #'FASLOAD
(MERGE-PATHNAMES "DLINE.FAS" *EXAMPLE-PATHNAME*)))
; switch to lo-resolution graphics
(DEFUN LO-RES () (%sysint #X10 4 0 0 0) t)
; return to alphanumeric
(DEFUN ALPHA () (%sysint #X10 3 0 0 0) t)
; set the colors (1 or 2)
(defun set-pallette (x)
(%sysint #x10 #x0b00 (logior #x100 (logand x 1)) 0 0)
)